perm filename TOPLEV.CLS[LST,LMM] blob sn#060152 filedate 1973-08-24 generic text, type T, neo UTF8
(FILECREATED "24-AUG-73 20:25:51" TOPLEVEL)


  (LISPXPRINT (QUOTE TOPLEVELVARS)
              T)
  (RPAQQ TOPLEVELVARS
         ((FNS MOLECULES SUPERATOMS RINGS RINGSKELETONS NOFVRINGS 
               DAISIES NOLOOPEDRINGS SINGLERINGS KLOOPEDRINGS)))
(DEFINEQ

(MOLECULES
  [LAMBDA (CL U)
    (if U=0
        then (GENMOL CL)
      else (for SAP in (SUPERATOMPARTITIONS CL U)
              join (for S in (SUPERATOMS (SUPERATOMPARTS SAP))
                      join (GENMOL <! (CLCREATE S)
                                      !
                                      (REMAININGATOMS SAP)>])

(SUPERATOMS
  [LAMBDA (UCLCOMP)
    (GROUPRADS (for UCLN in UCLCOMP collect <(RINGS UCLN:1:1 UCLN:1::1)
                                              ! UCLN::1>])

(RINGS
  [LAMBDA (U CL)
    (if (CLCOUNT CL)=2
        then CL←(CLEXPAND CL) <(STRUCWITH2NODES U+1 CL:1 CL:2)>
      else (PROG (FV)
                 (FV←(COMPUTEFV U CL))
                 (CL←(CLBYVALENCE CL))
                 (RETURN (for SKELETON
                            in (RINGSKELETONS FV
                                              (for X in CL
                                                 collect CLCOUNT))
                            join (STRUCTURESWITHATOMS CL SKELETON])

(RINGSKELETONS
  [LAMBDA (FV VL)
    (if FV=0
        then NOFVRINGS VL
      else (for FVSECTION in (GROUPBY (FUNCTION [LAMBDA (X)
                                          (NEWVL X])
                                      (FVPARTITIONS FV VL))
              bind STRUCLIST
              join (STRUCLIST←(NOFVRINGS FVSECTION:1))
                   (for FVPART in FVSECTION::1
                      join (for STRUC in STRUCLIST
                              join (ATTACHFVS (FVR FVPART)
                                              STRUC])

(NOFVRINGS
  [LAMBDA (VL)
    (PROG (MNLPS MXLPS SUMREST)
          (SUMREST←(SUM VL::1))
          (if (SUMREST=0)
              then (RETURN (SINGLERINGS VL:1))
            elseif (SUMREST=1)
              then (RETURN (DAISIES VL)))
          (MNLPS←(MINLOOPS VL))
          (MXLPS←(MAXLOOPS VL))
          (RETURN (for NEW P from MNLPS to MXLPS join (KLOOPEDRINGS
                                                        P VL])

(DAISIES
  [LAMBDA (VL)
    (for P
       in (NUMPARTITIONS VL:1
                         (for X in VL::1 as I from 3 while X=0
                            finally (RETURN I/2)
                            do NIL)
                         1 99999999)
       join (DAISY (CLCREATE P])

(NOLOOPEDRINGS
  [LAMBDA (VL)
    (if VL:1=0
        then (CATALOG VL::1)
      else (PROG (BP)
                 (BP←(BIVALENTPARTITIONS VL))
                 (RETURN (for S in (CATALOG VL::1)
                            join (for P in BP
                                    join (ATTACHBIVALENTS (CLCREATE
                                                            P)
                                                          S])

(SINGLERINGS
  [LAMBDA (N) <(SINGLERING N)>])

(KLOOPEDRINGS
  [LAMBDA (P VL)
    (if P=0
        then NOLOOPEDRINGS VL
      else (for LPSECTION in (LOOPPARTITIONS P VL) bind STRUCLIST
              when (STRUCLIST←(NOFVRINGS (LOOPVL LPSECTION:1)))
              join (for LOOPPART in LPSECTION
                      join (for STRUC in STRUCLIST
                              join (ATTACHBIVS&LOOPS (EDGELABELS 
                                                           LOOPPART)
                                                     (LOOPLABELS 
                                                           LOOPPART)
                                                     STRUC])
)
STOP